home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / rpc161a1.arc / RPC-PC.BAS < prev    next >
BASIC Source File  |  1988-04-13  |  30KB  |  610 lines
  1. ******************************************************************************
  2. ************************   RBBS-PC Protocol Controller   **** RPC-PC.BAS *****
  3. ************************      Merge for RBBS-PC.BAS      *********************
  4. ************************         By John Morris          ******* 16-1A *******
  5. ******************************************************************************
  6. 104 ACKNOWLEDGE$ = CHR$(6)
  7.     ACKC$ = "C" + _
  8.             ACKNOWLEDGE$
  9.     ACTIVE.MENU$ = "B"
  10.     ACTIVE.MESSAGE$ = CHR$(225)
  11.     BACKSPACE$ = CHR$(8) + _
  12.                  CHR$(32) + _
  13.                  CHR$(8)
  14.     BACK.ARROW$ = CHR$(29) + _
  15.                   CHR$(32) + _
  16.                   CHR$(29)
  17.     BULLETIN.MENU$ = ""
  18.     C.L = 24
  19.     CANCEL$ = CHR$(24)
  20.     COLOR.RESET$ = CHR$(27) + _
  21.                    "[00;37;40m"
  22.     CONFIG.FILENAME$ = "RBBS-PC.DEF"
  23.     CARRIAGE.RETURN$ = CHR$(13)
  24.     DELETED.MESSAGE$ = CHR$(226)
  25.     END.TRANSMISSION$ = CHR$(4)
  26.     ESCAPE$ = CHR$(27)
  27.     EXPECT.ACTIVE.MODEM = 0
  28.     FALSE = 0
  29.     F1.KEY = 59
  30.     F10.KEY = 68
  31.     GRN$ = "MAIN"
  32.     HOME.CONFERENCE$ = ""
  33.     IN.CONF.MENU = -1
  34.     LIMIT.MINUTES.PER.SESSION! = 0
  35.     LINE.FEED$ = CHR$(10)
  36.     LINE.FEEDS = NOT FALSE
  37.     LINEEDIT.CHK$ = CHR$(9) + _
  38.                     LINE.FEED$ + _
  39.                     CHR$(11) + _
  40.                     CHR$(12) + _
  41.                     CHR$(127) + _
  42.                     CHR$(8) + _
  43.                     CHR$(7) + _
  44.                     CHR$(26) + _
  45.                     CHR$(227)
  46.     LINEMES$ = SPACE$(74)          ' fixed length string workspace
  47.     LOCK.STATUS$ = "UM UU UB UD"
  48.     NEGATIVE.ACKNOWLEDGE$ = CHR$(21)
  49.     NO.ADVANCE = FALSE
  50.     PAGE.LENGTH = 23
  51.     PARSE.OFF = FALSE
  52.     PRESS.ENTER$ = " (Press [ENTER] to quit)"
  53.     PRESS.ENTER.EXPERT$ = " ([ENTER] quits)"
  54.     PRESS.ENTER.NOVICE$ = PRESS.ENTER$
  55.     PRIVATE.DOOR = FALSE
  56.     RIGHT.MARGIN = 72
  57.     RETURN.LINE.FEED$ = CARRIAGE.RETURN$ + _
  58.                         LINE.FEED$
  59.     START.OF.HEADER$ = CHR$(1)
  60.     TIME.LOGGED.ON$ = SPACE$(8)
  61.     TRUE = NOT FALSE
  62. * REPLACING old line(s) by new
  63. * ------[ first line different ]------
  64. 105 VERSION.ID$ = "CPC16.1A + RPC"
  65.     XOFF$ = CHR$(19)
  66.     XON$ = CHR$(17)
  67.     INTERRUPT.ON$ = CHR$(11) + CANCEL$ + XOFF$ + XON$ + CARRIAGE.RETURN$
  68.   ' ******************** Logon Error Message Table ****************************
  69. * REPLACING old line(s) by new
  70. 150 IF SUB.BOARD THEN _
  71.        GOSUB 12987 : _
  72.        GOSUB 5135 : _
  73.        GOTO 165
  74.     SYSOP.AVAILABLE = VAL(MID$(MESSAGE.RECORD$,32,2))
  75.     SYSOP.ANNOY = VAL(MID$(MESSAGE.RECORD$,34,2))
  76.     SYSOP.NEXT = VAL(MID$(MESSAGE.RECORD$,36,2))
  77.     PRINTER = VAL(MID$(MESSAGE.RECORD$,38,2))
  78.     IF TURN.PRINTER.OFF THEN _
  79.        PRINTER = FALSE
  80.     EXIT.TO.DOORS = VAL(MID$(MESSAGE.RECORD$,40,2))
  81.     EIGHT.BIT = VAL(MID$(MESSAGE.RECORD$,42,2))
  82.     BPS = VAL(MID$(MESSAGE.RECORD$,44,2))
  83.     SNOOP = VAL(MID$(MESSAGE.RECORD$,58,2))
  84.     MID$(MESSAGE.RECORD$,57,1) = "I"
  85. * ------[ first line different ]------
  86.     PRIVATE.DOOR = VAL(MID$(MESSAGE.RECORD$,72,2))
  87.     MID$(MESSAGE.RECORD$,72,2) = STR$(FALSE)
  88.     IF EXIT.TO.DOORS OR PRIVATE.DOOR THEN _
  89.        TURBO.LOGON = TRUE
  90.     PUT 1,NODE.RECORD.INDEX
  91.     GOSUB 12985
  92. '
  93. ' *****************************************************************************
  94. ' *  TEST FOR MULTI LINK PRESENT IF NOT COMPAQ COMPUTER                       *
  95. ' *****************************************************************************
  96. '
  97. * REPLACING old line(s) by new
  98. 200 TOGGLE.ONLY = TRUE
  99.     CALL ANSWERIT
  100.     GET 1,NODE.RECORD.INDEX
  101.     SNOOP = VAL(MID$(MESSAGE.RECORD$,58,2))
  102.     TOGGLE.ONLY = FALSE
  103.     IF EC > 1 THEN _
  104.        GOTO 13000
  105.     IF SUBROUTINE.PARAMETER < 0 THEN _
  106.        GOTO 202
  107.     ON SUBROUTINE.PARAMETER GOTO 410, _   '  1 = ANSWERED PHONE & CARRIER FOUND
  108.                                  330, _   '  2 = CARRIER FOUND BEFORE ANSWERING
  109.                                  822, _   '  3 = SYSOP GETS SYSTEM NEXT
  110.                                10595, _   '  4 = ANSWERED PHONE BUT NO CARRIER
  111.                                13540, _   '  5 = NOT USED
  112.                                  202, _   '  6 = LOCAL SYSOP KEY PRESSED
  113.                                  206, _   '  7 = TIME TO DROP TO DOS
  114. * ------[ first line different ]------
  115.                                13538      '  8 = NO CALLS! TIME TO RECYCLE
  116.  
  117. * REPLACING old line(s) by new
  118. 420 IF MID$(MESSAGE.RECORD$,57,1) = "A" THEN _
  119.        LOGON.ERROR.INDEX = 6 : _
  120.        LG$(6) = LG$(6) + _
  121.                 LEFT$(MESSAGE.RECORD$,25) : _
  122.        GOTO 10620
  123.     FIRST.NAME$ = LEFT$(MESSAGE.RECORD$,INSTR(MESSAGE.RECORD$, " ") - 1)
  124. * ------[ first line different ]------
  125.     IF (NOT PRIVATE.DOOR) THEN _
  126.        IF NOT (NOT EXIT.TO.DOORS) THEN _
  127.           CALL SKIPLINE (1) : _
  128.           CALL QTPUT(FIRST.NAME$ + ", welcome back!",1)
  129. '
  130. ' *****************************************************************************
  131. ' *  TEST FOR REMOTE SYSOP LOGGING ON                                         *
  132. ' *****************************************************************************
  133. '
  134. * REPLACING old line(s) by new
  135. * ------[ first line different ]------
  136. 480 IF (PRIVATE.DOOR) OR (EXIT.TO.DOORS) THEN _
  137.        Z$ = PASSWORD.SAVE$ : _
  138.        PASSWORD.FAILED = 0 : _
  139.        GOTO 644
  140.     IF Q => 3 THEN _
  141.        Z$ = B$(3) : _
  142.        ATTEMPTS = 1 : _
  143.        GOSUB 677 _
  144.     ELSE GOSUB 675
  145. * REPLACING old line(s) by new
  146. * ------[ first line different ]------
  147. 755 IF PRIVATE.DOOR OR (EXIT.TO.DOORS) THEN _
  148.        B$(1) = PASSWORD$ : _
  149.        Z$ = B$(1) : _
  150.        RETURN
  151.     GOSUB 12800
  152.     A$ = "Re-enter PASSWORD for verification (Dots Echo)"
  153.     GOSUB 45010
  154.     SWAP Z$,B$(1)
  155.     CALL ALLCAPS (Z$)
  156.     IF B$(1) <> Z$ THEN _
  157.        CALL QTPUT ("Passwords Don't match!",1) : _
  158.        GOTO 755
  159.     RETURN
  160. '
  161. ' *****************************************************************************
  162. ' *  R - COMMAND FROM NEWUSER ROUTINE - REGISTER                              *
  163. ' *****************************************************************************
  164. '
  165. * REPLACING old line(s) by new
  166. 800 IF ORIG.CONFIG$ = CURRENT.DEF$ THEN _
  167.        MAIN.USER.FILE.INDEX = USER.FILE.INDEX : _
  168.        USER.SECURITY.SAVE = USER.SECURITY.LEVEL
  169.     TIMES.LOGGED.ON = CVI(MID$(USER.OPTIONS$,1,2)) - _
  170.                       (ORIG.CONFIG$ <> CURRENT.DEF$ OR NOT SUB.BOARD)
  171.     GOSUB 9500
  172.     PREV.LAST.ON$ = LAST.DATE.TIME.ON$
  173.     IF NOT SUB.BOARD THEN _
  174.        BOARD.CHECK.DATE$ = PREV.LAST.ON$
  175. * ------[ first line different ]------
  176.     IF (PRIVATE.DOOR OR SUB.BOARD) OR (EXIT.TO.DOORS) THEN _
  177.        GOTO 815
  178.     GOSUB 465
  179.     IF (EIGHT.BIT AND _
  180.        AUTODOWNLOAD.DESIRED) OR _
  181.        ASK.IDENTITY THEN _
  182.        CALL TESTUSER
  183.     CALL QTPUT ("Logging " + ACTIVE.USER.NAME$,1)
  184.     CALL QTPUT ("RBBS-PC " + VERSION.ID$ + " NODE " + NODE.ID$,1)
  185.     CALL QTPUT (" OPERATING AT " + BAUD.PARITY$,1)
  186.     ATTEMPTS = 0
  187.     GOSUB 435
  188. * REPLACING old line(s) by new
  189. 828 EIGHT.BIT = TRUE
  190.     GR = 1
  191.     CI$ = "LOCAL"
  192. * ------[ first line different ]------
  193.     EXIT.TO.DOORS = FALSE
  194.     PRIVATE.DOOR = FALSE
  195.     TURBO.LOGON = FALSE
  196.     LINE.FEEDS = TRUE
  197.     RETURN.LINE.FEED$ = LINE.FEED$
  198.     USER.SECURITY.LEVEL = SYSOP.SECURITY.LEVEL
  199. * REPLACING old line(s) by new
  200. 900 GOSUB 1895
  201.     SUBROUTINE.PARAMETER = 2
  202.     CALL LINE25
  203.     CALL CALLOPT
  204.     SECTION$ = "    "
  205.     EXIT.TO.DOORS = FALSE
  206.     A$ = ""
  207.     NEW.USER = FALSE
  208.     GOSUB 2350
  209.     IF NOT PRIVATE.DOOR THEN _
  210.        GOTO 955
  211.     GOSUB 20262
  212. * ------[ first line different ]------
  213.     IF MENU.INDEX = 3 OR (TRANSFER.FUNCTION > 0) THEN _
  214.        GOSUB 1275 _
  215.     ELSE GOSUB 1280
  216.     PRIVATE.DOOR = FALSE
  217.     GOTO 1205
  218. * REPLACING old line(s) by new
  219. 1900 GOSUB 5344
  220. * ------[ first line different ]------
  221.      IF (PRIVATE.DOOR) OR (EXIT.TO.DOORS) THEN _
  222.         ACTION.FLAG = TRUE
  223.      PREV.BASE$ = ACTIVE.MESSAGE.FILE$
  224.      SHOW.ACTIVE = FALSE
  225.      IF NOT ACTION.FLAG THEN _
  226.         A$ = "Checking messages in " + _
  227.              GRN$ : _
  228.         GOSUB 12978 : _
  229.         SHOW.ACTIVE = TRUE _
  230.      ELSE CALL QTPUT ("Re-loading messages...",1) : _
  231.           FOR I = 1 TO Q: _
  232.              A$(I) = B$(I) : _
  233.           NEXT
  234.      I = 0
  235.      MESSAGES.FROM.USER = FALSE
  236.      ACTIVE.MESSAGES = 0
  237.      GOSUB 23000
  238.      MESSAGE.RECORD = FIRST.MESSAGE.RECORD
  239.      ACTIVE.DELAY! = 0
  240.      MAXIMUM.MESSAGES = VAL(MID$(MESSAGE.RECORD$,89,7))
  241.      IF MAXIMUM.MESSAGES > MM THEN _
  242.         MAXIMUM.MESSAGES = MM
  243.      REDIM M(MAXIMUM.MESSAGES,2)
  244. 5410 GOSUB 4241
  245.      GOSUB 43020
  246.      FF = INSTR(DFLTXFER$,USER.TRANSFER.DEFAULT$)
  247. * ------[ first line different ]------
  248.      FF = FF -(LEN(DFLTXFER$)) * (FF < 1)
  249.      GOSUB 42810
  250.      GOSUB 42970
  251.      GOSUB 4110
  252.      GOSUB 42720
  253.      GOSUB 4210
  254.      GOSUB 4125
  255.      GOSUB 4150
  256.      GOSUB 1560
  257.      IF RESTRICT.BY.DATE THEN _
  258.         IF USER.SECURITY.LEVEL > EXPIRED.SECURITY THEN _
  259.            CALL QTPUT ("Registration expires " + EXPIRATION.DATE$,1)
  260.      RETURN
  261. '
  262. ' *****************************************************************************
  263. ' *  B - COMMAND FROM UTILITY MENU (300 TO 450 BAUD CHANGE)                   *
  264. ' *****************************************************************************
  265. '
  266. * REPLACING old line(s) by new
  267. 12600 GOSUB 4910
  268.       GOSUB 12988
  269.       IF IN.CONF.MENU THEN _
  270. * ------[ first line different ]------
  271.          IF (NOT PRIVATE.DOOR) THEN _
  272.             IF (NOT EXIT.TO.DOORS) THEN _
  273.             CALL QTPUT ("Checking Users...",1)
  274. * REPLACING old line(s) by new
  275. * ------[ first line different ]------
  276. 13000 IF DEBUG THEN _
  277.          A$ = "RBBS-PC DEBUG Error Trap Entry ERL=" + _
  278.               STR$(EL) + _
  279.               " ERR=" + _
  280.               STR$(EC) : _
  281.               CALL PRINTIT(A$) : _
  282.               D$ = A$ : _
  283.               GOSUB 1315
  284.       IF EL = 1905 AND EC = 63 THEN _
  285.          CLOSE 1 : _
  286.          KILL ACTIVE.MESSAGE.FILE$ : _
  287.          GOTO 5350
  288.       IF EL = 4371 AND EC = 6 THEN _
  289.          GOTO 1200
  290.       IF EL =  4740 THEN _
  291.          GOTO 4745
  292.       IF EL =  5151 AND EC = 62 THEN _
  293.          CALL UPDTCALR (PASSWORDS.FILE$ + " bad format!",2) : _
  294.          GOTO 5160
  295.       IF EL =  7130 AND EC = 53 THEN _
  296.          GOTO 7260
  297.       IF EL = 20242 AND EC = 62 THEN _
  298.          CALL UPDTCALR (FILESEC.FILE$ + " bad format!",2) : _
  299.          GOTO 20247
  300.       IF (EL = 20262 AND EC = 5) OR _                                ' RPC16-1A
  301.          (EL = 20263 AND EC = 62) THEN _                             ' RPC16-1A
  302.          A$ = "<Download aborted>" : _                               ' RPC16-1A
  303.          DOWNLOAD.COMPLETED = FALSE : _                              ' RPC16-1A
  304.          GOTO 20390                                                  ' RPC16-1A
  305.       IF EL = 20262 AND EC = 53 THEN _                               ' RPC16-1A
  306.          GOTO 20267                                                  ' RPC16-1A
  307.       IF EL = 20263 AND EC = 53 THEN _                               ' RPC16-1A
  308.          IF TRANSFER.FUNCTION = 2 THEN _                             ' RPC16-1A
  309.             GOTO 20730 : _                                           ' RPC16-1A
  310.           ELSE _                                                     ' RPC16-1A
  311.             DOWNLOAD.COMPLETE = FALSE : _                            ' RPC16-1A
  312.             GOTO 20267                                               ' RPC16-1A
  313.       IF EL = 20452 AND EC = 53 THEN _
  314.          GOTO 20451
  315.       IF EL = 20560 AND EC = 67 THEN _
  316.          GOTO 20451
  317.       IF EL = 20560 AND EC = 70 THEN _
  318.          IF VAL(FREE.SPACE$) > 1999 THEN _
  319.             GOTO 20610 _
  320.          ELSE CALL QTPUT ("No room for uploads. Try tomorrow.",1) : _
  321.               GOTO 5160
  322.       IF EL = 20620 THEN _
  323.          GOTO 20670
  324.       IF EL = 20650 THEN _
  325.          GOTO 20670
  326.       IF EL = 20736 AND EC = 53 THEN _
  327.          GOTO 5160
  328.       IF EL = 20900 AND EC = 75 THEN _
  329.          GOTO 21230
  330.       IF EL = 20900 AND EC = 70 THEN _
  331.          CALL QTPUT ("No room for uploads. Try tomorrow.",1) : _
  332.          GOTO 21230
  333.       IF EL = 21131 THEN _
  334.          EC = 0 : _
  335.          GOTO 21230
  336.       IF EL = 21480 THEN _
  337.          CALL LOGERROR : _
  338.          IF EC = 57 THEN _
  339.             CALL QTPUT("Error reading file.  Aborting download",1) : _
  340.             DOWNLOAD.COMPLETED = FALSE : _
  341.             GOTO 21230
  342. * REPLACING old line(s) by new
  343. 20202 LAST.DOWNLOAD = Q
  344.       FIRST.DOWNLOAD = B
  345.       COMMAND.TRANSFER$ = ""
  346.       IF AUTODOWNLOAD.AVAILABLE THEN _
  347.          COMMAND.TRANSFER$ = "X"
  348.       AUTODOWNLOAD.IN.PROGRESS = AUTODOWNLOAD.AVAILABLE
  349.       IF LAST.DOWNLOAD > FIRST.DOWNLOAD THEN _
  350.          Z$ = B$(LAST.DOWNLOAD) : _
  351.          CALL ALLCAPS(Z$) : _
  352. * ------[ first line different ]------
  353.          IF LEN (Z$) = 1 AND INSTR(DFLTXFER$,Z$) > 0 THEN _          ' RPC16-1A
  354.             LAST.DOWNLOAD = LAST.DOWNLOAD - 1 : _
  355.             COMMAND.TRANSFER$ = Z$ : _
  356.             AUTODOWNLOAD.IN.PROGRESS = FALSE
  357.       FOR DWN.INDEX = FIRST.DOWNLOAD TO LAST.DOWNLOAD
  358.          GOSUB 20205
  359. * REPLACING old line(s) by new
  360. 20260 TRANSFER.FUNCTION = 1
  361. * ------[ first line different ]------
  362.       GOSUB 50630
  363.       IF FF = 1 THEN _                                               ' RPC16-1A
  364.          GOTO 20340                                                  ' RPC16-1A
  365.       IF INSTR("XC",FT$) THEN _                                      ' RPC16-1A
  366.          GOTO 20290                                                  ' RPC16-1A
  367.       IF FT$ = "Y" THEN _                                            ' RPC16-1A
  368.          GOTO 20270                                                  ' RPC16-1A
  369.       IF FT$ = "N" THEN 5160 ELSE 20261                              ' RPC16-1A
  370. '
  371. ' *****************************************************************************
  372. ' *  R - P - C       Control ALL External Protocol Drivers here               *
  373. ' *****************************************************************************
  374. '
  375. * REPLACING old line(s) by new
  376. * ------[ first line different ]------
  377. 20261 IF NOT PRIVATE.DOOR THEN                                       ' RPC16-1A
  378.         IF NOT EIGHT.BIT THEN                                        ' RPC16-1A
  379.            A$ = "Please SWITCH to N,8,1 for binary transfer"         ' RPC16-1A
  380.            CALL QTPUT(A$,1)                                          ' RPC16-1A
  381.            CALL DELAYIT (3)                                          ' RPC16-1A
  382.            IF NOT EIGHT.BIT THEN                                     ' RPC16-1A
  383.               CALL DELAYIT (3)                                       ' RPC16-1A
  384.               OUT LINE.CONTROL.REGISTER,3                            ' RPC16-1A
  385.            END IF                                                    ' RPC16-1A
  386.            SO = 0                                                    ' RPC16-1A
  387.         END IF                                                       ' RPC16-1A
  388.         IF INSTR("89",MODE$(FF)) THEN _                              ' RPC16-1A
  389.            BLOCK.SIZE = 8 _                                          ' RPC16-1A
  390.          ELSE BLOCK.SIZE = 1                                         ' RPC16-1A
  391.         IF TRANSFER.FUNCTION = 1 THEN _                              ' RPC16-1A
  392.            GOSUB 20750 : _                                           ' RPC16-1A
  393.            CLOSE 2                                                   ' RPC16-1A
  394.         IF AUTODOWNLOAD.IN.PROGRESS THEN _                           ' RPC16-1A
  395.            CALL SENDNAME : _                                         ' RPC16-1A
  396.            IF ABORT THEN _                                           ' RPC16-1A
  397.               DOWNLOAD.COMPLETED = FALSE : _                         ' RPC16-1A
  398.               GOSUB 50600 : _                                        ' RPC16-1A
  399.               RETURN                                                 ' RPC16-1A
  400.         CALL TRANSFER                                                ' RPC16-1A
  401.       END IF                                                         ' RPC16-1A
  402.       CLOSE 2                                                        ' RPC16-1A
  403.       CALL LINE25                                                    ' RPC16-1A
  404.       CALL CARRIER                                                   ' RPC16-1A
  405.       IF SUBROUTINE.PARAMETER = -1 THEN _                            ' RPC16-1A
  406.          A$ = "F" : _                                                ' RPC16-1A
  407.          GOTO 20264                                                  ' RPC16-1A
  408. * REPLACING old line(s) by new                                       ' RPC16-1A
  409. * ------[ first line different ]------                               ' RPC16-1A
  410. 20262 IF SUCCESS.CHECK.METHOD$(FF) = "DSZ" THEN                      ' RPC16-1A
  411.          IF TRANSFER.FUNCTION = 2 THEN _                             ' RPC16-1A
  412.             GOTO 20700                                               ' RPC16-1A
  413.          CLOSE 2                                                     ' RPC16-1A
  414.          CALL OPENWORK ("XFER-" + NODE.ID$ + ".DEF")                 ' RPC16-1A
  415.          IF EC <> 0 THEN _                                           ' RPC16-1A
  416.             EL = 20262 : _                                           ' RPC16-1A
  417.             GOTO 13000                                               ' RPC16-1A
  418.          CALL READDIR                                                ' RPC16-1A
  419.          IF (RUN.METHOD$(FF) = "E" AND PRIVATE.DOOR) AND (LEN(A$) > 1) THEN
  420.             FT$ = MID$(DFLTXFER$,FF,1)                               ' RPC16-1A
  421.             SIZE.ONLY = TRUE                                         ' RPC16-1A
  422.             GOSUB 20750                                              ' RPC16-1A
  423.          END IF                                                      ' RPC16-1A
  424.          DOWNLOAD.COMPLETED = TRUE                                   ' RPC16-1A
  425.          IF LEFT$(A$,1) = "E" OR LEFT$(A$,1) = "L" THEN _            ' RPC16-1A
  426.             DOWNLOAD.COMPLETED = FALSE                               ' RPC16-1A
  427.          GOSUB 50600                                                 ' RPC16-1A
  428.          CALL KILLWORK ("XFER-" + NODE.ID$ + ".DEF")                 ' RPC16-1A
  429.          RETURN                                                      ' RPC16-1A
  430.       END IF                                                         ' RPC16-1A
  431. * INSERTING new line(s)                                              ' RPC16-1A
  432. 20263 CALL OPENWORK ("XFER-" + NODE.ID$ + ".DEF")                    ' RPC16-1A
  433.       IF EC <> 0 THEN _                                              ' RPC16-1A
  434.          GOTO 20267                                                  ' RPC16-1A
  435.       FOR I = 1 TO 4                                                 ' RPC16-1A
  436.         CALL READANY                                                 ' RPC16-1A
  437.         IF EC <> 0 THEN _                                            ' RPC16-1A
  438.            GOTO 20267                                                ' RPC16-1A
  439.         IF I = 1 THEN _                                              ' RPC16-1A
  440.            C$ = A$                                                   ' RPC16-1A
  441.         IF I = 3 THEN _                                              ' RPC16-1A
  442.            B$ = A$                                                   ' RPC16-1A
  443.       NEXT                                                           ' RPC16-1A
  444. * REPLACING old line(s) by new                                       ' RPC16-1A
  445. * ------[ first line different ]------                               ' RPC16-1A
  446. 20264 IF PRIVATE.DOOR THEN _                                         ' RPC16-1A
  447.          PRIVATE.DOOR = 0 : _                                        ' RPC16-1A
  448.          FILE.NAME$ = C$ : _                                         ' RPC16-1A
  449.          CALL BRKFNAME (FILE.NAME$,X$,FILE.NAME.HOLD$,Y$,TRUE) : _   ' RPC16-1A
  450.          FILE.NAME.HOLD$ = FILE.NAME.HOLD$ + _                       ' RPC16-1A
  451.                            Y$ : _                                    ' RPC16-1A
  452.          FT$ = LEFT$(B$,1) : _                                       ' RPC16-1A
  453.          SIZE.ONLY = TRUE : _                                        ' RPC16-1A
  454.          GOSUB 20750                                                 ' RPC16-1A
  455.       IF TRANSFER.FUNCTION = 2 THEN _                                ' RPC16-1A
  456.          IF LEFT$(A$,1) = "S" THEN _                                 ' RPC16-1A
  457.             GOTO 20700 _                                             ' RPC16-1A
  458.          ELSE GOTO 20730                                             ' RPC16-1A
  459.       IF TRANSFER.FUNCTION = 1 THEN _                                ' RPC16-1A
  460.          IF LEFT$(A$,1) = "S" THEN _                                 ' RPC16-1A
  461.             DOWNLOAD.COMPLETED = TRUE _                              ' RPC16-1A
  462.          ELSE DOWNLOAD.COMPLETED = FALSE                             ' RPC16-1A
  463.       GOSUB 50600                                                    ' RPC16-1A
  464.       RETURN                                                         ' RPC16-1A
  465. '
  466. ' *****************************************************************************
  467. ' *  XFER FILE NOT FOUND                                                      *
  468. ' *****************************************************************************
  469. '
  470. * DELETING old line(s)
  471. 20265
  472. * REPLACING old line(s) by new
  473. 20292 GOSUB 20750                                                    ' RPC16-1A
  474. * ------[ first line different ]------
  475.       A1$ = "send"                                                   ' RPC16-1A
  476.       GOSUB 20320                                                    ' RPC16-1A
  477.       IF AUTODOWNLOAD.IN.PROGRESS THEN _                             ' RPC16-1A
  478.          CALL SENDNAME : _                                           ' RPC16-1A
  479.          IF ABORT THEN _                                             ' RPC16-1A
  480.             RETURN 20792                                             ' RPC16-1A
  481.       GOSUB 21300                                                    ' RPC16-1A
  482.       A$ = ""                                                        ' RPC16-1A
  483.       GOTO 20390                                                     ' RPC16-1A
  484. * REPLACING old line(s) by new                                       ' RPC16-1A
  485. * ------[ first line different ]------
  486. 20330 IF AUTODOWNLOAD.IN.PROGRESS THEN _                             ' RPC16-1A
  487.          RETURN                                                      ' RPC16-1A
  488.       A$ = "Xmodem" + _                                              ' RPC16-1A
  489.             XMODEM.TYPE$ + _                                         ' RPC16-1A
  490.             A1$ + _                                                  ' RPC16-1A
  491.             " of " + _                                               ' RPC16-1A
  492.             FILE.NAME.HOLD$ + _                                      ' RPC16-1A
  493.             " ready.  <Ctrl X> aborts"                               ' RPC16-1A
  494.       IF FF = 4 THEN _                                               ' RPC16-1A
  495.          MID$(A$,1,1) = "Y"                                          ' RPC16-1A
  496.       GOSUB 12979                                                    ' RPC16-1A
  497.       RETURN                                                         ' RPC16-1A
  498. '
  499. ' *****************************************************************************
  500. ' *  ASCII DOWNLOAD DRIVER                                                    *
  501. ' *****************************************************************************
  502. '
  503. * REPLACING old line(s) by new
  504. 20340 IF DF THEN _                                                   ' RPC16-1A
  505.          A$ = "Switch to a non-ascii protocol" : _                   ' RPC16-1A
  506.          GOSUB 12979 : _                                             ' RPC16-1A
  507.          RETURN                                                      ' RPC16-1A
  508.       CALL OPENWORK (FILE.NAME$)                                     ' RPC16-1A
  509.       BLOCK.SIZE = 1                                                 ' RPC16-1A
  510.       GOSUB 20760                                                    ' RPC16-1A
  511.       IF (DWN.INDEX = FIRST.DOWNLOAD OR NOT CONCAT.FILES) THEN _     ' RPC16-1A
  512.          A$ = "^X aborts.  ^S suspends ^Q resumes" : _               ' RPC16-1A
  513.          GOSUB 12977 : _                                             ' RPC16-1A
  514. * ------[ first line different ]------
  515.          A$ = "Ascii send of " + _                                   ' RPC16-1A
  516.               FILE.NAME.HOLD$ + _                                    ' RPC16-1A
  517.               " ready. Press [ENTER] to start" : _                   ' RPC16-1A
  518.          GOSUB 12995                                                 ' RPC16-1A
  519. * REPLACING old line(s) by new
  520. 20500 TRANSFER.FUNCTION = 2                                          ' RPC16-1A
  521. * ------[ first line different ]------
  522.       AUTODOWNLOAD.IN.PROGRESS = FALSE                               ' RPC16-1A
  523.       GOSUB 50630                                                    ' RPC16-1A
  524.       IF FF = 1 THEN _                                               ' RPC16-1A
  525.          GOTO 20560                                                  ' RPC16-1A
  526.       IF INSTR("XC",FT$) THEN _                                      ' RPC16-1A
  527.          GOTO 20540                                                  ' RPC16-1A
  528.       IF FT$ = "Y" THEN _                                            ' RPC16-1A
  529.          GOTO 20520                                                  ' RPC16-1A
  530.       IF FT$ = "N" THEN 20735 ELSE 20261                             ' RPC16-1A
  531. * REPLACING old line(s) by new
  532. * ------[ first line different ]------
  533. 20542 A1$ = "receive"                                                ' RPC16-1A
  534.       GOSUB 20320                                                    ' RPC16-1A
  535.       OK = TRUE                                                      ' RPC16-1A
  536.       GOSUB 20860                                                    ' RPC16-1A
  537.       IF OK THEN _                                                   ' RPC16-1A
  538.          GOTO 20700                                                  ' RPC16-1A
  539.       GOTO 20730                                                     ' RPC16-1A
  540. '
  541. ' *****************************************************************************
  542. ' *  ASCII UPLOAD                                                             *
  543. ' *****************************************************************************
  544. '
  545. * REPLACING old line(s) by new
  546. 20560 LINE.ACK = (DEFAULT.LINE.ACK$ <> "")                           ' RPC16-1A
  547.       IF LINE.ACK THEN _                                             ' RPC16-1A
  548.          A$ = "Acknowledge each line ([Y],N)" : _                    ' RPC16-1A
  549.          GOSUB 12995 : _                                             ' RPC16-1A
  550.          LINE.ACK = NOT NO                                           ' RPC16-1A
  551.       CALL QTPUT("Transfer MUST end with a <Ctrl-K>",1)              ' RPC16-1A
  552. * ------[ first line different ]------
  553.       CALL QTPUT("Ascii receive of " + FILE.NAME.HOLD$ + " ready",1) ' RPC16-1A
  554.       OK = FALSE                                                     ' RPC16-1A
  555.       XOFF = FALSE                                                   ' RPC16-1A
  556.       CALL OPENOUTW(FILE.NAME$)                                      ' RPC16-1A
  557.       IF EC <> 0 AND EC <> 53 THEN _                                 ' RPC16-1A
  558.          EL = 20560 : _                                              ' RPC16-1A
  559.          GOTO 13000                                                  ' RPC16-1A
  560.       GOSUB 20510                                                    ' RPC16-1A
  561. * REPLACING old line(s) by new
  562. * ------[ first line different ]------
  563. 20750 IF FF = 4 THEN _                                               ' RPC16-1A
  564.          START.OF.HEADER$ = CHR$(2) : _                              ' RPC16-1A
  565.          BLOCK.SIZE = 1 : _                                          ' RPC16-1A
  566.          FLEN = 1024 _                                               ' RPC16-1A
  567.       ELSE START.OF.HEADER$ = CHR$(1) : _                            ' RPC16-1A
  568.            FLEN = 128                                                ' RPC16-1A
  569.       SWAP BUFFER.SIZE,FLEN                                          ' RPC16-1A
  570.       CALL OPENRSEQ (FILE.NAME$,MAX.BLOCK,DF)                        ' RPC16-1A
  571.       SWAP BUFFER.SIZE,FLEN                                          ' RPC16-1A
  572. * REPLACING old line(s) by new
  573. 20780 A$ = "FILE SIZE: "                                             ' RPC16-1A
  574. * ------[ first line different ]------
  575.       IF INSTR("245",MODE$(FF)) THEN _                               ' RPC16-1A
  576.          A$ = A$ + _                                                 ' RPC16-1A
  577.            STR$(CINT((FIX(BLOCKS.IN.FILE#) / BLOCK.SIZE)+.49)) + _   ' RPC16-1A
  578.            " blocks "                                                ' RPC16-1A
  579. * REPLACING old line(s) by new
  580. * ------[ first line different ]------
  581. 20785 TLA = 143                                                      ' RCP16-1A
  582.       BLOCKS.IN.FILE# = BLOCKS.IN.FILE# * _                          ' RPC16-1A
  583.                         TLA / _                                      ' RPC16-1A
  584.                         VAL(MID$("0000030004501200240048009601920", -4 * BPS, 4))
  585.       BLOCKS.IN.FILE# = BLOCKS.IN.FILE# * FLEN / 128                 ' RPC16-1A
  586.       IF (DWN.INDEX > 1 AND CONCAT.FILES) THEN _                     ' RPC16-1A
  587.          GOTO 20792                                                  ' RPC16-1A
  588.       A$ = A$ + _                                                    ' RPC16-1A
  589.            STR$(BYTES.IN.FILE#) + _                                  ' RPC16-1A
  590.            " bytes"                                                  ' RPC16-1A
  591.       GOSUB 12979                                                    ' RPC16-1A
  592.       IF BYTES.IN.FILE# < 1 THEN _                                   ' RPC16-1A
  593.          RETURN 20792                                                ' RPC16-1A
  594. * REPLACING old line(s) by new
  595. * ------[ first line different ]------
  596. 42810 IF PROT.NAME$(FF) = "" THEN _                                  ' RPC16-1A
  597.          USER.PROTOCOL$ = "None" ELSE _                              ' RPC16-1A
  598.          USER.PROTOCOL$ = PROT.NAME$(FF)                             ' RPC16-1A
  599.       A$ = "PROTOCOL: " + _                                          ' RPC16-1A
  600.            USER.PROTOCOL$                                            ' RPC16-1A
  601.       GOSUB 12979                                                    ' RPC16-1A
  602.       RETURN                                                         ' RPC16-1A
  603. '
  604. ' *****************************************************************************
  605. ' *  C - COMMAND FROM UTILITY MENU (CHANGE CASE TOGGLE)                       *
  606. ' *  UPPER/LOWER CASE SET FOR NEW USERS                                       *
  607. ' *****************************************************************************
  608. '
  609.  
  610.